home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / turbo_tk.arc / MISCTTT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-01  |  3KB  |  141 lines
  1. {$S-,R-,V-,D-,T-}
  2. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  3. {         TechnoJocks Turbo Toolkit v4.00            Released: Feb 1, 1988    }
  4. {                                                                             }
  5. {         Module: MiscTTT    --   a few miscellaneous procs                   }
  6. {                                                                             }
  7. {                       Copyright R. D. Ainsbury (c) 1986                     }
  8. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  9.  
  10. Unit MiscTTT;
  11.  
  12. Interface
  13.  
  14. Uses CRT,DOS;
  15.  
  16. Function Exist(Filename:string):boolean;
  17. Function time: string;
  18. Function Date: String;
  19. Procedure PrintScreen;
  20. Procedure Beep;
  21. Function printer_ready :boolean;
  22. Procedure FlushKeyBuffer;
  23. Procedure Reset_Printer;
  24.  
  25. Implementation
  26.  
  27. Function Exist(Filename:string):boolean;
  28. {returns true if file exists}
  29. var Fil : file;
  30. begin
  31.  Assign(Fil,Filename);
  32.  {$I-}
  33.  Reset(Fil);
  34.  Close(Fil);
  35.  {$I+}
  36.  Exist := (IOresult = 0);
  37. end;  {Func Exist}
  38.  
  39. function time: string;
  40. var
  41.   hour,min,sec:     string[2];
  42.   H,M,S,T : word;
  43. begin
  44.     GetTime(H,M,S,T);
  45.     Str(H,Hour);
  46.     Str(M,Min);
  47.     Str(S,Sec);
  48.     if S < 10 then            {pad a leading zero if sec is < 10 }
  49.       sec := '0'+sec;
  50.     if M < 10 then            {pad a leading zero if min is < 10 }
  51.         min := '0'+min;
  52.     if H > 12 then           { assign an a.m. or p.m. string }
  53.     begin
  54.        str(H - 12,hour);
  55.        IF length(hour) = 1 then Hour := ' '+hour;
  56.           time := hour+':'+min+':'+sec+' p.m.'
  57.     end
  58.     else
  59.        time := hour+':'+min+':'+sec+' a.m.';
  60.     if H = 12 then
  61.        time := hour+':'+min+':'+sec+' p.m.';
  62. end;
  63.  
  64. function Date: String;
  65. type
  66.   WeekDays = array[0..6]  of string[9];
  67.   Months   = array[1..12] of string[9];
  68. const
  69.     DayNames   : WeekDays  = ('Sunday','Monday','Tuesday','Wednesday',
  70.                               'Thursday','Friday','Saturday');
  71.     MonthNames : Months    = ('January','February','March','April','May',
  72.                               'June','July','August','September',
  73.                               'October','November','December');
  74. var
  75.  Y,
  76.  M,
  77.  D,
  78.  DayOfWeek : word;
  79.  Year   : string;
  80.  Day    : string;
  81. begin
  82.     GetDate(Y,M,D,DayofWeek);
  83.     Str(Y,Year);
  84.     Str(D,Day);
  85.     Date := DayNames[DayOfWeek]+' '+MonthNames[M]+' '+Day+', '+Year;
  86. end;
  87.  
  88.  
  89. Procedure PrintScreen;
  90. var Regpack : registers;
  91. begin
  92.     intr($05,regpack);
  93. end;
  94.  
  95. procedure Beep;
  96. begin
  97.     sound(800);Delay(150);
  98.     sound(600);Delay(100);
  99.     Nosound;
  100. end;
  101.  
  102.  
  103. function printer_ready :boolean;
  104. var Recpack : registers;
  105. begin
  106.     with recpack do
  107.     begin
  108.         ah := 2;
  109.         dx := 0;
  110.         intr($17,recpack);
  111.         if ah = 144 then
  112.            printer_ready := true
  113.         else
  114.            printer_ready := false;
  115.     end;
  116. end;
  117.  
  118. Procedure FlushKeyBuffer;
  119. var Recpack : registers;
  120. begin
  121.     with recpack do
  122.     begin
  123.         Ax := ($0c shl 8) or 6;
  124.         Dx := $00ff;
  125.     end;
  126.     Intr($21,recpack);
  127. end;
  128.  
  129. Procedure Reset_Printer;
  130.  
  131. var address: integer absolute $0040:$0008;
  132.              portno,delay : integer;
  133.  
  134. begin
  135.     portno := address + 2;
  136.     port[portno] := 232;
  137.     for delay := 1 to 2000 do {nothing};
  138.         port[portno] := 236;
  139. end;
  140.  
  141. end.